home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / zuck / top9.bas < prev    next >
Encoding:
BASIC Source File  |  1994-10-06  |  9.7 KB  |  266 lines
  1. ' ------------------------------------------------------------------------
  2. '
  3. '     Top9.BAS -- Top 9 API Tricks
  4. '
  5. '                       Copyright (C) 1993 Desaware
  6. '
  7. '  You have a royalty-free right to use, modify, reproduce and distribute
  8. '  this file (and/or any modified version) in any way you find useful,
  9. '  provided that you agree that Desaware has no
  10. '  warranty, obligation or liability for its contents.
  11. '
  12. ' ------------------------------------------------------------------------
  13. Option Explicit
  14.  
  15. Global LastCommand%  ' Number of latest command
  16.  
  17. Type RECT   '8 Bytes
  18.     left As Integer
  19.     top As Integer
  20.     right As Integer
  21.     bottom As Integer
  22. End Type
  23.  
  24. Type POINTAPI  '4 Bytes - Synonymous with LONG
  25.     X As Integer
  26.     Y As Integer
  27. End Type
  28.  
  29. Type SIZEAPI  '4 Bytes - Synonymous with LONG
  30.     X As Integer
  31.     Y As Integer
  32. End Type
  33.  
  34. Type TASKENTRY  ' 40 bytes
  35.     dwSize As Long
  36.     hTask As Integer
  37.     hTaskParent As Integer
  38.     hInst As Integer
  39.     hModule As Integer
  40.     wSS As Integer
  41.     wSP As Integer
  42.     wStackTop As Integer
  43.     wStackMinimum As Integer
  44.     wStackBottom As Integer
  45.     wcEvents As Integer
  46.     hQueue As Integer
  47.     szModule As String * 10
  48.     wPSPOffset As Integer
  49.     hNext As Integer
  50. End Type
  51.  
  52.  
  53.  
  54.  
  55.  
  56. Global Const VK_NUMLOCK = &H90
  57. Global Const VK_SCROLL = &H91
  58. Global Const VK_CAPITAL = &H14
  59.  
  60.  
  61. Global Const BITSPIXEL = 12 '  Number of bits per pixel
  62. Global Const PLANES = 14    '  Number of planes
  63.  
  64. Global Const DT_WORDBREAK = &H10
  65.  
  66. Global Const GWW_HINSTANCE = (-6)
  67.  
  68. Global Const WM_USER = &H400
  69. Global Const EM_GETLINECOUNT = WM_USER + 10
  70. Global Const LB_SETTABSTOPS = (WM_USER + 19)
  71.  
  72. Global Const MF_INSERT = &H0
  73. Global Const MF_CHANGE = &H80
  74. Global Const MF_APPEND = &H100
  75. Global Const MF_DELETE = &H200
  76. Global Const MF_REMOVE = &H1000
  77.  
  78. Global Const MF_BYCOMMAND = &H0
  79. Global Const MF_BYPOSITION = &H400
  80.  
  81. Global Const MF_SEPARATOR = &H800
  82.  
  83. Global Const MF_ENABLED = &H0
  84. Global Const MF_GRAYED = &H1
  85. Global Const MF_DISABLED = &H2
  86.  
  87. Global Const MF_UNCHECKED = &H0
  88. Global Const MF_CHECKED = &H8
  89. Global Const MF_USECHECKBITMAPS = &H200
  90.  
  91. Global Const MF_STRING = &H0
  92. Global Const MF_BITMAP = &H4
  93. Global Const MF_OWNERDRAW = &H100
  94.  
  95. Global Const MF_POPUP = &H10
  96. Global Const MF_MENUBARBREAK = &H20
  97. Global Const MF_MENUBREAK = &H40
  98.  
  99. Global Const MF_UNHILITE = &H0
  100. Global Const MF_HILITE = &H80
  101.  
  102. Global Const MF_SYSMENU = &H2000
  103. Global Const MF_HELP = &H4000
  104. Global Const MF_MOUSESELECT = &H8000
  105.  
  106. Global Const HWND_BROADCAST = -1
  107.  
  108. Global Const WM_CLOSE = &H10
  109. Global Const WM_WININICHANGE = &H1A
  110.  
  111. Global Const PS_SOLID = 0
  112. Global Const PS_DASH = 1    '  -------
  113. Global Const PS_DOT = 2 '  .......
  114. Global Const PS_DASHDOT = 3 '  _._._._
  115. Global Const PS_DASHDOTDOT = 4  '  _.._.._
  116. Global Const R2_XORPEN = 7  '  DPx
  117. Global Const NULL_BRUSH = 5
  118.  
  119. Global Const SW_HIDE = 0
  120. Global Const SW_SHOWNORMAL = 1
  121. Global Const SW_NORMAL = 1
  122. Global Const SW_SHOWMINIMIZED = 2
  123. Global Const SW_SHOWMAXIMIZED = 3
  124. Global Const SW_MAXIMIZE = 3
  125. Global Const SW_SHOWNOACTIVATE = 4
  126. Global Const SW_SHOW = 5
  127. Global Const SW_MINIMIZE = 6
  128. Global Const SW_SHOWMINNOACTIVE = 7
  129. Global Const SW_SHOWNA = 8
  130. Global Const SW_RESTORE = 9
  131.  
  132. Global Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  133. Global Const SRCPAINT = &HEE0086    ' (DWORD) dest = source OR dest
  134. Global Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
  135. Global Const SRCINVERT = &H660046   ' (DWORD) dest = source XOR dest
  136. Global Const SRCERASE = &H440328    ' (DWORD) dest = source AND (NOT dest )
  137. Global Const NOTSRCCOPY = &H330008  ' (DWORD) dest = (NOT source)
  138. Global Const NOTSRCERASE = &H1100A6 ' (DWORD) dest = (NOT src) AND (NOT dest)
  139. Global Const MERGECOPY = &HC000CA   ' (DWORD) dest = (source AND pattern)
  140. Global Const MERGEPAINT = &HBB0226  ' (DWORD) dest = (NOT source) OR dest
  141. Global Const PATCOPY = &HF00021 ' (DWORD) dest = pattern
  142. Global Const PATPAINT = &HFB0A09    ' (DWORD) dest = DPSnoo
  143. Global Const PATINVERT = &H5A0049   ' (DWORD) dest = pattern XOR dest
  144. Global Const DSTINVERT = &H550009   ' (DWORD) dest = (NOT dest)
  145. Global Const BLACKNESS = &H42&  ' (DWORD) dest = BLACK
  146. Global Const WHITENESS = &HFF0062   ' (DWORD) dest = WHITE
  147.  
  148.  
  149. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  150. Declare Sub ClientToScreen Lib "User" (ByVal hWnd%, lpPoint As POINTAPI)
  151. Declare Sub CloseWindow Lib "User" (ByVal hWnd%)
  152. Declare Function CreateDC% Lib "GDI" (ByVal lpDriverName$, lpDeviceName As Any, lpOutput As Any, lpInitData As Any)
  153. Declare Function CreatePen% Lib "GDI" (ByVal nPenStyle%, ByVal nWidth%, ByVal crColor&)
  154. Declare Function CreateSolidBrush% Lib "GDI" (ByVal crColor&)
  155. Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
  156. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  157. Declare Function DrawText% Lib "User" (ByVal hDC%, ByVal lpStr$, ByVal nCount%, lpRect As RECT, ByVal wFormat%)
  158. Declare Function FindWindowByString% Lib "User" Alias "FindWindow" (ByVal lpClassName&, ByVal lpWindowName$)
  159. Declare Function FindWindowByCaption% Lib "User" Alias "FindWindow" (ByVal lpClassName&, ByVal lpWindowName$)
  160. Declare Function FindWindowByClass% Lib "User" Alias "FindWindow" (ByVal lpClassName$, ByVal lpWindowName&)
  161. Declare Sub GetClientRect Lib "User" (ByVal hWnd%, lpRect As RECT)
  162. Declare Function GetDC% Lib "User" (ByVal hWnd%)
  163. Declare Function GetDeskTopWindow% Lib "User" ()
  164. Declare Function GetDeviceCaps% Lib "GDI" (ByVal hDC%, ByVal nIndex%)
  165. Declare Function GetKeyState% Lib "User" (ByVal nVirtKey%)
  166. Declare Function GetMenu% Lib "User" (ByVal hWnd%)
  167. Declare Function GetMenuCheckMarkDimensions& Lib "User" ()
  168. Declare Function GetMenuItemCount% Lib "User" (ByVal hMenu%)
  169. Declare Function GetMenuItemID% Lib "User" (ByVal hMenu%, ByVal nPos%)
  170. Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
  171. Declare Function GetProfileString% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName As Any, ByVal lpDefault$, ByVal lpReturnedString$, ByVal nSize%)
  172. Declare Function GetStockObject% Lib "GDI" (ByVal nIndex%)
  173. Declare Function GetSubMenu% Lib "User" (ByVal hMenu%, ByVal nPos%)
  174. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As RECT)
  175. Declare Function GetWindowWord% Lib "User" (ByVal hWnd%, ByVal nIndex%)
  176. Declare Sub InflateRect Lib "User" (lpRect As RECT, ByVal X%, ByVal Y%)
  177. Declare Function ModifyMenu% Lib "User" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal wIDNewItem%, ByVal lpString As Any)
  178. Declare Function ModifyMenuBynum% Lib "User" Alias "ModifyMenu" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal wIDNewItem%, ByVal lpString&)
  179. Declare Function ModifyMenuBystring% Lib "User" Alias "ModifyMenu" (ByVal hMenu%, ByVal nPosition%, ByVal wFlags%, ByVal wIDNewItem%, ByVal lpString$)
  180. Declare Function PostMessageBynum% Lib "User" Alias "PostMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
  181. Declare Function Rectangle% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  182. Declare Function ReleaseDC% Lib "User" (ByVal hWnd%, ByVal hDC%)
  183. Declare Sub ScreenToClient Lib "User" (ByVal hWnd%, lpPoint As POINTAPI)
  184. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  185. Declare Function SendMessageBynum& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
  186. Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
  187. Declare Function SendMessageByString& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam$)
  188. Declare Function SetCapture% Lib "User" (ByVal hWnd%)
  189. Declare Function SetROP2% Lib "GDI" (ByVal hDC%, ByVal nDrawMode%)
  190. Declare Sub SetWindowText Lib "User" (ByVal hWnd%, ByVal lpString$)
  191. Declare Function TaskFirst% Lib "Toolhelp.dll" (lpTask As TASKENTRY)
  192. Declare Function TaskNext% Lib "Toolhelp.dll" (lpTask As TASKENTRY)
  193. Declare Function WinExec% Lib "Kernel" (ByVal lpCmdLine$, ByVal nCmdShow%)
  194. Declare Function WriteProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName$, ByVal lpString$)
  195.  
  196. Function FormattedHex$ (value%, length%)
  197.     Dim f$
  198.     f$ = Hex$(value%)
  199.     While (Len(f$) < length%)
  200.     f$ = "0" & f$
  201.     Wend
  202.     FormattedHex$ = f$
  203.  
  204. End Function
  205.  
  206. Function NullTermToVBString$ (usestr$)
  207.     Dim position%
  208.     position% = InStr(usestr, Chr$(0))
  209.     If position% <= 1 Then
  210.     NullTermToVBString$ = ""
  211.     Exit Function
  212.     End If
  213.     NullTermToVBString$ = Left$(usestr$, position% - 1)
  214.     
  215. End Function
  216.  
  217. Function NumberOfColors& (ByVal hDC%)
  218.     Dim numplanes%, numbitspixel%
  219.     Dim numcolors&
  220.     numplanes% = GetDeviceCaps%(hDC, PLANES)
  221.     numbitspixel% = GetDeviceCaps%(hDC, BITSPIXEL)
  222.     ' Left shift operation
  223.     numcolors& = 2 ^ (numplanes% * numbitspixel%)
  224.     
  225.     NumberOfColors& = numcolors&
  226.  
  227. End Function
  228.  
  229. '
  230. ' Extracts the idx%'th string from source$, where the substrings
  231. ' are separated by character sep$
  232. '
  233. Function ParseAnyString$ (source$, ByVal idx%, ByVal sep$)
  234.     Dim nexttab%, basepos%, thispos%
  235.     Dim res$
  236.     basepos% = 1
  237.     thispos% = 0
  238.     If (Len(source$) = 0) Then
  239.     ParseAnyString$ = ""
  240.     Exit Function
  241.     End If
  242.     Do
  243.     nexttab% = InStr(basepos%, source$, sep$)
  244.     If nexttab% = 0 Then nexttab% = Len(source$) + 1
  245.     ' Now points to next tab or 1 past end of string
  246.     ' The following should never happen
  247.     ' If nexttab% = basepos% Then GoTo ptsloop1
  248.  
  249.     If thispos% = idx% Then
  250.     If nexttab% - basepos% - 1 < 0 Then
  251.     res$ = ""
  252.     Else
  253.     res$ = Mid$(source$, basepos%, nexttab% - basepos%)
  254.     End If
  255.     Exit Do
  256.     End If
  257. ptsloop1:
  258.     basepos% = nexttab% + 1
  259.     thispos% = thispos% + 1
  260.     Loop While (basepos% <= Len(source$))
  261.     ParseAnyString$ = res$
  262.  
  263.  
  264. End Function
  265.  
  266.